home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
COMAL
/
T-COMAL Today
/
(k)tc.d64
/
dump1520.proc
< prev
next >
Wrap
Text File
|
2007-02-28
|
2KB
|
120 lines
9000 //
9005 PROC DUMP1520(REVERSE,COLOR) CLOSED
9010 DIM D$ OF 1
9015 DIM MO$ OF 1
9020 DIM P$ OF 1
9025 DIM XC$ OF 3
9030 DIM YC$ OF 4
9035 DIM POS$ OF 9
9040 DIM ENDL$ OF 3
9045 IF REVERSE THEN
9050 D$:="M"; MO$:="D"
9055 ELSE
9060 D$:="D"; MO$:="M"
9065 ENDIF
9070 OPEN FILE 1,"",UNIT 6,1,WRITE
9075 OPEN FILE 6,"",UNIT 6,0,WRITE
9080 OPEN FILE 2,"",UNIT 6,2,WRITE
9085 OPEN FILE 7,"",UNIT 6,7,WRITE
9090 PRINT FILE 2: CHR$(COLOR+ORD("0")),
9095 //
9100 FOR I:=1 TO 10 DO
9105 PRINT FILE 6:
9110 ENDFOR I
9115 PRINT FILE 1: " M80 199"
9120 FOR Y:=199 TO 0 STEP -2 DO
9125 YC$:=""
9130 STRPP(YC$,Y)
9135 YC$:=" "+YC$
9140 POS$:="M80"+YC$
9145 YY:=Y
9150 Z:=GETCOLOR(0,YY)
9155 PRINT FILE 1: POS$
9160 FOR I:=1 TO 2 DO
9165 IF I=1 THEN
9170 SS:=0
9175 FF:=319
9180 SP:=1
9185 ENDL$:="399"
9190 ELSE
9195 FF:=0
9200 SS:=319
9205 SP:=-1
9210 ENDL$:="80"
9215 YY:=Y-1
9220 YC$:=""
9225 STRPP(YC$,YY)
9230 YC$:=" "+YC$
9235 POS$:="M"+"399"+YC$
9240 PRINT FILE 1: POS$
9245 ENDIF
9250 FOR X:=SS TO FF STEP SP DO
9255 IF GETCOLOR(X,YY)<>Z THEN
9260 CASE Z OF
9265 WHEN 1
9270 P$:=MO$
9275 OTHERWISE
9280 P$:=D$
9285 ENDCASE
9290 XC$:=""
9295 XX:=X
9300 IF I=2 THEN XX:=XX+1
9305 STRPP(XC$,XX+80)
9310 POS$:=P$+XC$+YC$
9315 PRINT FILE 1: POS$
9320 Z:=GETCOLOR(X,YY)
9325 ENDIF
9330 ENDFOR X
9335 Z:=GETCOLOR(319,YY)
9340 IF Z<>1 THEN
9345 POS$:=D$+ENDL$+YC$
9350 PRINT FILE 1: POS$
9355 ENDIF
9360 Z:=GETCOLOR(319,Y-1)
9365 ENDFOR I
9370 ENDFOR Y
9375 PRINT FILE 1: "M"
9380 PRINT FILE 6: CHR$(13),CHR$(13)
9385 PRINT FILE 7:
9390 CLOSE
9395 ENDPROC DUMP1520
9400 //
9405 PROC STRPP(REF C$,N) CLOSED
9410 DIM T$ OF 6
9415 N:=ABS(N)
9420 D:=N MOD 10
9425 T$:=T$+CHR$(D+48)
9430 IF D=N THEN
9435 C$:=C$+T$
9440 ELSE
9445 STRPP(C$,(N-D)/10)
9450 C$:=C$+T$
9455 ENDIF
9460 ENDPROC STRPP
9465 //
9470 PROC STR(REF C$,N) CLOSED
9475 DIM T$ OF 11, S$ OF 1, DD$ OF 5
9480 IF N<0 THEN S$:="-"
9485 N:=ABS(N)
9490 IF (N DIV 1)<>N THEN
9495 F:=INT((N*10000) MOD 10000+.5)
9500 STR(DD$,F)
9505 DD$:="."+DD$
9510 P:=LEN(DD$)
9515 WHILE DD$(P)="0" AND P>1 DO
9520 DD$:=DD$(1:P-1)
9525 P:=P-1
9530 ENDWHILE
9535 N:=N DIV 1
9540 ENDIF
9545 D:=N MOD 10
9550 T$:=T$+CHR$(D+48)
9555 IF D=N THEN
9560 C$:=C$+T$
9565 ELSE
9570 STR(C$,(N-D)/10)
9575 C$:=C$+T$
9580 ENDIF
9585 C$:=S$+C$+DD$
9590 ENDPROC STR